#######################################
## Americans, Not Partisans Project  ##
## NAES Online Panel Data Analysis   ##
## Started: Fall 2015                ## 
## Finalized: January 2017           ## 
#######################################

## read in the data 
library(foreign) 
naes <- read.dta(file="waves23_v12.dta",
                 convert.factors=F,
                 convert.underscore=T)

## Candidate feeling thermometers 
bho.therm2 <- ifelse(naes$ABo02.2<101,naes$ABo02.2,NA)
bho.therm3 <- ifelse(naes$ABo02.3<101,naes$ABo02.3,NA)
jm.therm2 <- ifelse(naes$AAm01.2<101,naes$AAm01.2,NA)
jm.therm3 <- ifelse(naes$AAm01.3<101,naes$AAm01.3,NA)

## party ID
pid <- (-1*naes$MA01.3) + 8 ## KN reverses PID scale 
sp <- ifelse(pid==1 | pid ==7,1,0)
dem <- ifelse(pid<4,1,
              ifelse(pid>4,0,NA))

## pool parties into out-party & same-party effects
outparty.ft <- ifelse(pid<4,jm.therm3,
                      ifelse(pid>4,bho.therm3,NA))
outparty.ft2 <- ifelse(pid<4,jm.therm2,
                       ifelse(pid>4,bho.therm2,NA))
sameparty.ft <- ifelse(pid>4,jm.therm3,
                       ifelse(pid<4,bho.therm3,NA))

############################################
## Define Treatments Relative to July 4th ##
############################################

## Code up the Interview Date 
finish.date <- as.Date(as.character(naes$DATE.3), format="%Y%m%d") 

## 14-day window (June 27-July 10 vs. May 30-June 12/August 1-14)
window14 <- ifelse(((finish.date>"2008-05-29" &
                       finish.date<"2008-06-13") | 
                      (finish.date>"2008-07-31" &
                         finish.date<"2008-08-15")),0,
                   ifelse(finish.date>"2008-06-26" &
                            finish.date<"2008-07-11",1,NA))

## 10-day window (June 29-July 9 vs. June 1-10/August 3-12)
window10 <- ifelse(((finish.date>"2008-05-31" &
                       finish.date<"2008-06-11") | 
                      (finish.date>"2008-08-02" &
                         finish.date<"2008-08-13")),0,
                   ifelse(finish.date>"2008-06-28" &
                          finish.date<"2008-07-10",1,NA))

## 7-day window (July 1-7 vs. June 1-7/August 1-7)
window7 <- ifelse((finish.date>"2008-05-31" &
                    finish.date<"2008-06-08") | 
                    (finish.date>"2008-07-31" &
                       finish.date<"2008-08-08"),0,
                  ifelse(finish.date>"2008-06-30" &
                           finish.date<"2008-07-08",1,NA))

## 5-day window (July 2-6 vs. June 4-8/August 6-11)
window5 <- ifelse(((finish.date>"2008-06-03" &
                      finish.date<"2008-06-09") | 
                     (finish.date>"2008-08-05" &
                        finish.date<"2008-08-12")),0,
                  ifelse(finish.date>"2008-07-01" &
                           finish.date<"2008-07-07",1,NA))


## 3-day window: July 3-5 vs. June 5-7 or August 7-9 
window3 <- ifelse(((finish.date>"2008-06-04" &
                   finish.date<"2008-06-08") | 
                   (finish.date>"2008-08-06" &
                    finish.date<"2008-08-10")),0,
                 ifelse(finish.date>"2008-07-02" &
                          finish.date<"2008-07-06",1,NA))

## One Day Window (July 4th vs. June 6th/August 8th)  
window1 <- ifelse((finish.date=="2008-06-06"| finish.date=="2008-08-08"),0,
                   ifelse(finish.date=="2008-07-04",1,NA))


## look at days from July 4th (continuous)
julyfourth <- as.Date("2008-07-04")
days.away <- abs(finish.date-julyfourth) 
days.squared <- as.numeric(days.away)^2
wk.away <- days.away/7 
weeks.away <- trunc(wk.away)
days.squared <- as.numeric(days.away)^2 
days.cubed <- as.numeric(days.away)^3 


#############
## Table 4 ## 
#############

summary(lm(outparty.ft ~ window14))
summary(lm(outparty.ft ~ window10))
summary(lm(outparty.ft ~ window7))
summary(lm(outparty.ft ~ window5))
summary(lm(outparty.ft ~ window3))
summary(lm(outparty.ft ~ window1)) 
summary(lm(outparty.ft ~ days.away, subset=wk.away<5))
summary(lm(outparty.ft ~ weeks.away, subset=wk.away<5)) 
summary(lm(outparty.ft ~ days.away + outparty.ft2, subset=wk.away<5))
summary(lm(outparty.ft ~ weeks.away + outparty.ft2, subset=wk.away<5))

## 90% CIs 
library(stats) 
confint(lm(outparty.ft ~ window14), level=.90) 
confint(lm(outparty.ft ~ window10), level=.90) 
confint(lm(outparty.ft ~ window7), level=.90) 
confint(lm(outparty.ft ~ window5), level=.90) 
confint(lm(outparty.ft ~ window3), level=.90) 
confint(lm(outparty.ft ~ window1), level=.90) 
confint(lm(outparty.ft ~ days.away, subset=wk.away<5), level=.9)
confint(lm(outparty.ft ~ weeks.away, subset=wk.away<5), level=.9)
confint(lm(outparty.ft ~ days.away + outparty.ft2, subset=wk.away<5), level=.9)
confint(lm(outparty.ft ~ weeks.away + outparty.ft2, subset=wk.away<5), level=.9)
 
######################################
## Analyses for the Online Appendix ##
######################################

## Placebo Test: Same-Party Feeling Thermometers (Appendix)
summary(lm(sameparty.ft ~ window14))
summary(lm(sameparty.ft ~ window10))
summary(lm(sameparty.ft ~ window7))
summary(lm(sameparty.ft ~ window5))
summary(lm(sameparty.ft ~ window3))
summary(lm(sameparty.ft ~ window1))
summary(lm(sameparty.ft ~ days.away, subset=wk.away<5))
summary(lm(sameparty.ft ~ weeks.away, subset=wk.away<5))
## nothing for windows, weak efx for days/weeks, but wrong sign 


## Demographics 
female <- ifelse(naes$WA01==2,1,0)
age <- naes$WA02 
educ <- naes$WA03 
income <- naes$WA05
white <- ifelse(naes$WC01 == 1,1,0)
black <- ifelse(naes$WC01 == 2,1,0)
hispanic <- ifelse(naes$WC01==4,1,0)

## Models with demographic controls 
summary(lm(outparty.ft ~ window14 + female + age + educ + income + white + black + hispanic + pid))
summary(lm(outparty.ft ~ window10 + female + age + educ + income + white + black + hispanic + pid))
summary(lm(outparty.ft ~ window7 + female + age + educ + income + white + black + hispanic + pid))
summary(lm(outparty.ft ~ window5 + female + age + educ + income + white + black + hispanic + pid))
summary(lm(outparty.ft ~ window1 + female + age + educ + income + white + black + hispanic + pid))
summary(lm(outparty.ft ~ window3 + female + age + educ + income + white + black + hispanic + pid))
summary(lm(outparty.ft ~ days.away + female + age + educ + income + white + black + hispanic + pid, subset=wk.away<5))
summary(lm(outparty.ft ~ weeks.away + female + age + educ + income + white + black + hispanic + pid, subset=wk.away<5))
## No substantive differences 

## Try CEM to control for any imbalances 
library(cem)

## Age quantiles 
quantile(age)
age.quant <- ifelse(age<25,1,
                    ifelse(age>24 & age<51,2,
                           ifelse(age>50 & age<61,3,
                                  ifelse(age>60,4,NA))))

## education: less than HS, HS grad, BA or more 
educ.cat <- ifelse(educ<3,1,
                   ifelse(educ==3 | educ==4 | educ==5,2,
                          ifelse(educ>5,3,NA)))

## income: quartiles 
quantile(income)
income.quant <- ifelse(income<9,1,
                       ifelse(income>8 & income < 12,2,
                              ifelse(income>11 & income<14,3,
                                     ifelse(income>13,4,NA))))

## Matrix of Data to be used 
matching.data <- data.frame(age.quant,
                            educ.cat,
                            income.quant,
                            female, 
                            white,
                            black,
                            hispanic,
                            dem,
                            sp,
                            outparty.ft,
                            window14,
                            window10,
                            window7,
                            window5,
                            window3,
                            window1)

match.14 <- cem(treatment="window14",
             data=matching.data,
             drop=c("window10","window7","window5","window3","window1","outparty.ft"))
match.14
att(match.14, outparty.ft  ~ window14, data=matching.data)$att.model 

match.10 <- cem(treatment="window10",
                data=matching.data,
                drop=c("window14","window7","window5","window3","window1","outparty.ft"))
match.10
att(match.10, outparty.ft  ~ window10, data=matching.data)$att.model 

match.7 <- cem(treatment="window7",
                data=matching.data,
                drop=c("window14","window10","window5","window3","window1","outparty.ft"))
match.7
att(match.7, outparty.ft  ~ window7, data=matching.data)$att.model 

match.5 <- cem(treatment="window5",
               data=matching.data,
               drop=c("window14","window10","window7","window3","window1","outparty.ft"))
match.5
att(match.5, outparty.ft  ~ window5, data=matching.data)$att.model 

match.3 <- cem(treatment="window3",
               data=matching.data,
               drop=c("window14","window10","window5","window7","window1","outparty.ft"))
match.3
att(match.3, outparty.ft  ~ window3, data=matching.data)$att.model 

match.1 <- cem(treatment="window1",
               data=matching.data,
               drop=c("window14","window10","window5","window7","window3","outparty.ft"))
match.1
att(match.1, outparty.ft  ~ window1, data=matching.data)$att.model 
## same basic pattern of results 


## Look at the Olympics as an alternative prime to national identity 
## Olympics are 8/8-8/24 
## DNC begins next day (plus Labor Day right after), so focus on opening ceremony + first week (almost all golds come then)

## opening ceremony effect: compare 2 days following (8/9-8/10) to 2 preceding days (8/7-8/8)
olympics1 <- ifelse(finish.date>"2008-08-08" & finish.date<"2008-08-11",1, 
                    ifelse(finish.date>"2008-08-06" & finish.date<"2008-08-09",0,NA))
summary(lm(outparty.ft ~ olympics1))
## 2.5 deg diff, but N = 295, so not enough power to detect 

## 8/15 - 8/17: Phelp's 6th, 7th and 8th gold medals 
## compare to weekend before Olympics 
olympics2 <- ifelse(finish.date>"2008-08-14" & finish.date<"2008-08-18",1, 
                    ifelse(finish.date>"2008-07-31" & finish.date<"2008-08-04",0,NA))
summary(lm(outparty.ft ~ olympics2))
## 4.5 point effect! 
## effect on 8/16 is basically equivalent to effect of convention speech 

## look at same-party effects 
summary(lm(sameparty.ft ~ olympics1)) 
summary(lm(sameparty.ft ~ olympics2)) 
## no effect on same-party thermometers 